perm filename BLOWUP.SAI[GEO,BGB] blob
sn#001335 filedate 1972-10-28 generic text, type T, neo UTF8
00100 BEGIN "BLOWUP"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "DD[DD,BGB]" SOURCE_FILE;
00500 REQUIRE "COMMON[TV,BGB]" SOURCE_FILE;
00600 α LEAPING LIZARDS;
00700 REQUIRE 100 NEW_ITEMS;
00800 REQUIRE 100 PNAMES;
00900 α TELETYPE COMMAND STATE;
01000 INTEGER CHR,CTRL,META,LETT,MCBITS;
01100 α SOURCE AND OBJECT WINDOWS;
01200 DEFINE
01300 SX. = "DATUM(SWINDO)[1]",
01400 SY. = "DATUM(SWINDO)[2]",
01500 DX. = "DATUM(SWINDO)[3]",
01600 DY. = "DATUM(SWINDO)[4]",
01700 OX. = "DATUM(OWINDO)[1]",
01800 OY. = "DATUM(OWINDO)[2]",
01900 MP = "DATUM(OWINDO)[3]";
02000 INTEGER FLG;
00100 PRELOAD_WITH 1,2,3,4,0,0;
00200 SAFE INTEGER ARRAY CHAN[1:7];
00300 α NEW _DPYDD CALLS DDJOB;
00400 PROCEDURE _DPYDD; DPYDD(CVIS(TVFILE,FLG),∂(SWINDO),∂(OWINDO),CHAN);
01200 α SET CHANNELS;
01300 PROCEDURE SETCHN;
01400 BEGIN "SETCHN"
01500 INTEGER I,ARG;
01600 ARG ← INCHRW;
01700 IF ARG≤"0" ∨ "7"≤ARG THEN RETURN;
01800 ARG ← ARG LAND 7;
01900 CHAN[1] ← 0;
02000 ARRBLT(CHAN[2],CHAN[1],5);
02100 IF CHR="←" THEN CHAN[ARG]←1 ELSE
02200 IF CHR="↑" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I ELSE
02300 IF CHR="↓" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I+1 ELSE
02400 RETURN;
02500 _DPYDD;
02600 END "SETCHN";
00100 PROCEDURE CARCAM;
00200 BEGIN "CARCAM"
00300 DEFINE MM="*3.2808@-3";
00400 LDX ← 144;
00500 LDY ← 108;
00600 LDZ ← 500;
00700 PDX ← 5.3 MM;
00800 PDY ← 4.0 MM;
00900 FOCAL ← 12.5 MM;
01000 SCALX ← -FOCAL*LDX/PDX;
01100 SCALY ← -FOCAL*LDY/PDY;
01200 SCALZ ← FOCAL*LDZ;
01300 END "CARCAM";
01400
01700 PROCEDURE INITIALIZATION;
01800 BEGIN "INIT"
01900 INTEGER ARRAY ∂S[1:5],∂O[1:7];
02000 SWINDO ← NEW(∂S); NEW_PNAME(SWINDO,"S0");
02100 OWINDO ← NEW(∂O); NEW_PNAME(OWINDO,"O0");
02200 SX.←SY.←0;
02300 OX. ← 0;
02400 OY. ← 0;
02500 DX. ← 144;
02600 DY. ← 108;
02700 MP ← 0;
02800 DELTA ← 1;
02900 LINK ← NEW;
03000 NIL ← NEW;
03100 LOCOR ← NEW;
03200 CARCAM;
03300 OUTSTR("*");
03400 END "INIT";
00100 α WINDOW MOVING KEYS;
00200 PROCEDURE MOVKEY;
00300 BEGIN "MOVKEY"
00400 IF META THEN
00500 BEGIN
00600 IF CHR=";" ∧ OX.-DELTA≥0 THEN OX.←OX.-DELTA ELSE
00700 IF CHR=":" ∧ OX.+DELTA≤511 THEN OX.←OX.+DELTA ELSE
00800 IF CHR="(" ∧ OY.+DELTA*8<480 THEN OY.←OY.+DELTA*8 ELSE
00900 IF CHR=")" ∧ OY.-DELTA*8≥0 THEN OY.←OY.-DELTA*8 ;
01000 END ELSE
01100 IF CTRL THEN
01200 BEGIN
01300 IF CHR=";" THEN SX.←SX.-DELTA ELSE
01400 IF CHR=":" THEN SX.←SX.+DELTA ELSE
01500 IF CHR="(" THEN SY.←SY.-DELTA ELSE
01600 IF CHR=")" THEN SY.←SY.+DELTA;
01700 END ELSE
01800 BEGIN
01900 IF CHR=";" THEN SX.←SX.-DX. ELSE
02000 IF CHR=":" THEN SX.←SX.+DX. ELSE
02100 IF CHR="(" THEN SY.←SY.-DY. ELSE
02200 IF CHR=")" THEN SY.←SY.+DY.;
02300 END;
02400 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
02500 IF SX.-DX.<-144 THEN SX.←-144+DX.;
02600 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
02700 IF SY.-DY.<-108 THEN SY.←-108+DY.;
02800 _DPYDD;
02900 END "MOVKEY";
00100 α WINDOW SIZE CONTROL KEYS;
00200 PROCEDURE DELKEY;
00300 BEGIN "DELKEY"
00400 IF CHR="[" ∧ DY.≠1 THEN DY.←DY.-1 ELSE
00500 IF CHR="]" ∧ DY.≠108 THEN DY.←DY.+1 ELSE
00600 IF CHR="↑" ∧ DX.≠1 THEN DX.←DX.-1 ELSE
00700 IF CHR="↓" ∧ DX.≠144 THEN DX.←DX.+1;
00800 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
00900 IF SX.-DX.<-144 THEN SX.←-144+DX.;
01000 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
01100 IF SY.-DY.<-108 THEN SY.←-108+DY.;
01200 _DPYDD;
01300 END "DELKEY";
00100 PROCEDURE DIGIT;
00200 BEGIN "DIGIT"
00300 INTEGER DIG;
00400 DEFINE OXY(X,Y)="BEGIN OX.←X;OY.←Y;END";
00500 DIG ← CHR LAND '17;
00600 IF META THEN
00700 CASE DIG OF
00800 BEGIN
00900 OXY(0,0);
01000 OXY(128,120);
01100 OXY(-128,120);
01200 OXY(-128,-120);
01300 OXY(128,-120);
01400 OY.←120;
01500 OY.←-120;
01600 OX.←-128;
01700 OX.←0;
01800 OX.←128;
01900 END ELSE
02000 CASE DIG OF
02100 BEGIN
02200 SX.←SY.←0;
02300 MP←0;
02400 ;
02500 ;
02600 DX.←DY.←4;
02700 DX.←DY.←9;
02800 DX.←DY.←18;
02900 DX.←DY.←36;
03000 BEGIN DX.←72;DY.←54;END;
03100 BEGIN DX.←144;DY.←108;SX.←SY.←0;END;
03200 END;
03300 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
03400 IF SX.-DX.<-144 THEN SX.←-144+DX.;
03500 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
03600 IF SY.-DY.<-108 THEN SY.←-108+DY.;
03700 END "DIGIT";
00100 PROCEDURE INSERIES;
00200 BEGIN "INSERIES"
00300 INTEGER L,M,FLG;
00400 STRING STR,S;
00500 OPEN(1,"TTY",0,1,0,0,0,0);
00600 OUTSTR(" SERIES = ");S←INCHWL;
00700 OUTSTR(" FIRST = ");L←INTIN(1);
00800 OUTSTR(" LAST = ");M←INTIN(1);
00900 RELEASE(1);
01000 IF L>M THEN L↔M;
01100 DO BEGIN
01200 STR ← S&CVS(L);
01300 α DSKTV.;
01400 TVFILE←CVSI(STR,FLG);
01500 IF FLG THEN
01550 BEGIN
01575 TVFILE←NEW(0);
01587 PUT TVFILE IN TVSET;
01593 NEW_PNAME(TVFILE,STR);
01596 END;
01600 END UNTIL M<(L←L+1);
01700 OUTCHR("*");
01800 END "INSERIES";
01900
02000 α INPUT A 216 BY 288 TV IMAGE FROM THE DSK;
02100 PROCEDURE INDSK;
02200 BEGIN "INDSK"
02300 STRING STR;
02400 INTEGER FLG;
02500 OPEN(1,"DSK",8,3,0,0,0,0);
02600 OUTSTR(13&10);
02700 DO BEGIN
02750 EXTERNAL STRING TVSTR;
02775 IF LENGTH(TVSTR)=0 THEN BEGIN
02800 OUTSTR ("FILE = ");
02900 STR ← INCHWL; END ELSE STR←TVSTR;
03000 IF STR<"A" ∨ "Z"<STR THEN BEGIN RELEASE(1);INSERIES;RETURN;END;
03100 LOOKUP(1,STR&".TMP[DAT,BGB]",FLG);
03150 TVSTR←"";
03200 END UNTIL ¬FLG;
03300 RELEASE(1);
03302 TVFILE←CVSI(STR,FLG);
03304 IF FLG THEN
03306 BEGIN TVFILE←NEW(0);
03308 PUT TVFILE IN TVSET;
03310 NEW_PNAME(TVFILE,STR);
03312 END;
04200 OUTCHR("*");
04300 END "INDSK";
00100 PROCEDURE XXXXXX;
00200 BEGIN "XXXXXX"
00300 WHILE TRUE DO
00400 BEGIN "LISTEN"
00500 CHR ← INCHRW;
00600 MCBITS ← (CHR LSH -7)LAND 3;
00700 CTRL ← CHR LAND '200;
00800 META ← CHR LAND '400;
00900 CHR ← CHR LAND '177;
01000 LETT ← CHR LAND '37;
01100 IF "A"≤CHR ∧ CHR≤"Z" ∨ "a"≤CHR ∧ CHR≤"z" THEN
01200 CASE LETT OF
01300 BEGIN ;
01400 "A" ;
01500 "B" ;
01600 "C" ;
01700 "D" _DPYDD;
01800 "E" ERASTV;
01900 "F" ;
02000 "G" ;
02100 "H" ;
02200 "I" INDSK;
02300 "J" ;
02400 "K" ;
02500 "L" ;
02600 "M" ;
02700 "N" ;
02800 "O" ;
02900 "P" ;
03000 "Q" ;
03100 "R" ;
03200 "S" ;
03300 "T" BEGIN EXTERNAL PROCEDURE TVSUBR;TVSUBR;INDSK;END;
03400 "U" ;
03500 "V" ;
03600 "W" ;
03700 "X" ;
03800 "Y" ;
03900 "Z" ;
04000 END ELSE
00100 α ASCII 00 TO 37 ;
00200 IF CHR < "A" THEN CASE CHR OF BEGIN
00300 "NULL" ;
00400 "↓" SETCHN;
00500 "α" ;
00600 "β" ;
00700 "∧" ;
00800 "¬" ;
00900 "ε" ;
01000 "π" ;
01100 "λ" ;
01200 "TAB" ;
01300 "LF" ;
01400 "VT" ;
01500 "FF" ;
01600 "CR" OUTSTR("*");
01700 "∞" ;
01800 "∂" ;
01900 "⊂" ;
02000 "⊃" ;
02100 "∩" ;
02200 "∪" ;
02300 "∀" ;
02400 "∃" ;
02500 "⊗" ;
02600 "↔" ;
02700 "_" ;
02800 "→" ;
02900 "TILDE" ;
03000 "≠" ;
03100 "≤" ;
03200 "≥" ;
03300 "≡" ;
03400 "∨" ;
00100 α ASCII 40 TO 77;
00200 "SPACE" ;
00300 "!" ;
00400 """" ;
00500 "#" BEGIN INTEGER I;FOR I←1 STEP 1 UNTIL 30 DO OUTSTR(13&10);END;
00600 "$" ;
00700 "%" ;
00800 "&" ;
00900 "'" ;
01000 "(" MOVKEY;
01100 ")" MOVKEY;
01200 "*" MP←MP+1;
01300 "+" ;
01400 "," ;
01500 "-" IF MP≠0 THEN MP←MP-1;
01600 "." ;
01700 "/" IF DELTA≠1 THEN DELTA←DELTA-1;
01800 "0" DIGIT;
01900 "1" DIGIT;
02000 "2" DIGIT;
02100 "3" DIGIT;
02200 "4" DIGIT;
02300 "5" DIGIT;
02400 "6" DIGIT;
02500 "7" DIGIT;
02600 "8" DIGIT;
02700 "9" DIGIT;
02800 ":" MOVKEY;
02900 ";" MOVKEY;
03000 "<" ;
03100 "=" ;
03200 ">" ;
03300 "?" ;
03400 "@" ;
03500 END ELSE
00100 IF CHR<"a" THEN CASE CHR-'133 OF
00200 BEGIN
00300 "[" DELKEY;
00400 "\" DELTA←DELTA+1;
00500 "]" DELKEY;
00600 "↑" SETCHN;
00700 "←" SETCHN;
00800 "`" ;
00900 END
01000 ELSE CASE CHR-'173 OF
01100 BEGIN
01200 "{" ;
01300 "|" ;
01400 "ALTMODE" ;
01500 "}" ;
01600 "RUBOUT";
01700 END;
01800 END "LISTEN";
01900 END "XXXXXX";
02000
02100 INITIALIZATION;
02200 XXXXXX;
02300 END "BLOWUP"